perm filename XXX.B[C,JRA] blob sn#021221 filedate 1973-01-19 generic text, type T, neo UTF8
00100	(DEFPROP MATCH T *LSUBR)(DEFPROP PATTERN T *SUBR)
00125	
00137	 
00150	(DEFPROP CSET T *LSUBR)
00200	
00250	(SPECIAL PATTERN ALISTS *ITEMS)
00300	(DEFPROP FETCHI1 
00400	 (LAMBDA(PATTERN CON)
00500	  (PROG (ALISTS)
00600		(RETURN
00700		 (MAPCAN (FUNCTION
00800			  (LAMBDA(ITEM)
00900			   (COND
01000			    ((SETQ ALISTS (MATCH PATTERN (CAR ITEM))) (LIST (LIST (QUOTE *ITEM) ITEM (CAR ALISTS)))))))
01100			 (SEARCH *ITEMS PATTERN T (CDR CON)))))) 
01200	EXPR)
01300	
01400	(DEFPROP FETCHM1 
01500	 (LAMBDA(PATTERN INDEX CON)
01600	  (MAPCAN (FUNCTION
01700		   (LAMBDA(METHOD)
01800		    ((LAMBDA(MRESULT)
01900		      (COND (MRESULT (LIST (CONS (QUOTE *METHOD) (CONS METHOD (NCONC MRESULT (LIST PATTERN))))))))
02000		     (MATCH (PATTERN METHOD) PATTERN))))
02100		  (SEARCH INDEX PATTERN NIL (CDR CON)))) 
02200	EXPR)
02300	
02350	(SPECIAL CON)(UNSPECIAL PATTERN ALISTS *ITEMS)
02400	(DEFPROP SEARCH 
02500	 (LAMBDA(INDEX PATTERN ITEM CON)
02600	  (MAPCAN (FUNCTION (LAMBDA (THING) (COND ((REALITY1 (CDR (CMARKERS THING)) CON) (LIST THING)))))
02700		  (ISEARCH INDEX PATTERN ITEM))) 
02800	EXPR)
02900	
05700	
05750	(SPECIAL ALIST TEM)(DEFPROP ACCESS T *LSUBR)
05800	(DEFPROP SETUP 
05900	 (LAMBDA (ALIST)(PROG2 (SETQ TEM (ACCESS)) (MAPC (FUNCTION (LAMBDA (PAIR) (CSET (CAR PAIR) (CADR PAIR) TEM))) ALIST)) )
06000	EXPR)
06100	
06150	(DEFPROP VLOC T *LSUBR)(SPECIAL L)(DEFPROP /, T *FSUBR)
06200	(DEFPROP PROPOSE 
06300	 (LAMBDA(L)(PROG2
06400	  (SETQ L (CDR (VLOC (QUOTE NEXT))))
06500	  (MAPC (FUNCTION (LAMBDA (X)(PROG2 (RPLACD (CAR L) (CONS X (CDAR L))) (RPLACA L (CDAR L))))) (/, L))) )
06600	FEXPR)